home *** CD-ROM | disk | FTP | other *** search
/ EnigmA Amiga Run 1998 July / EnigmA AMIGA RUN 29 (1998)(G.R. Edizioni)(IT)[!][issue 1998-07 & 08].iso / earkit / news / thor / rexx / adduser.thor < prev    next >
Text File  |  1998-05-24  |  11KB  |  375 lines
  1. /*
  2.  * $VER: AddUser.thor 1.50 (4.9.97)
  3.  *
  4.  * by Magne Østlyngen and Eirik Synnes
  5.  *
  6.  * Adds the sender or any recipient of the current or multiselected
  7.  * messages to the user database.
  8.  *
  9.  * New in 1.3:
  10.  *  Messages can be multiselected
  11.  *  Abiity to add addresses from all From:, To: and Cc: header lines
  12.  *  Now handles double quotes and asterixes
  13.  *  Some minor bugfixes and improvements
  14.  *
  15.  * New in 1.4:
  16.  *  Some debug info was left in 1.3 making the script useless :/
  17.  *  Replaced the four confirmation requesters with one listview
  18.  *  Existing entries in the user database can optionally be replaced
  19.  *
  20.  * New in 1.41:
  21.  *  Put the "Cancel" choice in the editing requesters back in
  22.  *  The script would always quit after adding one user
  23.  *
  24.  * New in 1.42:
  25.  *  Fixed some remaining problems with double quotes and asterixes
  26.  *
  27.  * New in 1.50:
  28.  *  Users can be multiselected
  29.  *  Version numbering will from now on be following the C= guidelines
  30.  *
  31.  */
  32.  
  33. options results
  34. options failat 31
  35.  
  36. msglist.count = 0
  37.  
  38. p = ' ' || address() || ' ' || show('P',,)
  39. thorport = pos(' THOR.',p)
  40.  
  41. if thorport > 0 then thorport = word(substr(p,thorport+1),1)
  42. else
  43. do
  44.     say 'No THOR port found!'
  45.     exit 10
  46. end
  47.  
  48. if ~show('p', 'BBSREAD') then do
  49.     address command
  50.     "run >nil: `GetEnv THOR/THORPath`bin/LoadBBSRead"
  51.     "WaitForPort BBSREAD"
  52. end
  53.  
  54. address(thorport)
  55. 'CURRENTSYSTEM STEM 'cursys
  56. if (rc ~= 0) then do
  57.     if (rc = 1) then do
  58.         'REQUESTNOTIFY "No system open." "Ok"'
  59.         exit(0)
  60.     end
  61.     else do
  62.         'REQUESTNOTIFY "CURRENTSYSTEM failed: 'THOR.LASTERROR'" "Ok"'
  63.         exit(0)
  64.     end
  65. end
  66.  
  67. if (cursys.CONFNAME = '') then do
  68.     'REQUESTNOTIFY "No conference open." "Ok"'
  69.     exit(0)
  70. end    
  71.  
  72.  
  73. 'GETMSGLISTSELECTED STEM 'msglist
  74. select
  75.     when (rc = 3 | rc = 5) then do
  76.         'CURRENTMSG STEM 'msg
  77.         if rc~=0 then do
  78.             REQUESTNOTIFY '"CURRENTMSG failed: '||THOR.LASTERROR||'"' '"Ok"'
  79.             exit
  80.         end
  81.         msglist.1 = msg.msgnr; msglist.count = 1
  82.         drop msg.
  83.     end
  84.     when (rc = 0) then nop
  85.     otherwise do
  86.         'REQUESTNOTIFY "GETMSGLISTSELECTED failed: 'THOR.LASTERROR'" "Ok"'
  87.         exit(0)
  88.     end
  89. end
  90.  
  91. do i = 1 to msglist.count
  92.     drop new. userlist. head. text.
  93.  
  94.     cancelled = 0
  95.  
  96.     address(bbsread)
  97.     'READBRMESSAGE "'||cursys.bbsname||'" "'||cursys.confname||'" 'msglist.i' HEADSTEM 'head' TEXTSTEM 'text
  98.     if (rc ~=0) then do
  99.         address(thorport)
  100.         'REQUESTNOTIFY "READBRMESSAGE failed on message ' || msglist.i || ':\n' || BBSREAD.LASTERROR || '" "Ok"'
  101.         exit
  102.     end
  103.  
  104.     call parseaddr(1, 1)
  105.  
  106.     do j = 1 to addrs.count
  107.         userlist.j = left(addrs.j.name, 30) || ' '
  108.         userlist.j = userlist.j || '<' || addrs.j.addr || '>'
  109.     end
  110.     userlist.count = addrs.count
  111.  
  112.     do while ~(cancelled)
  113.         address(thorport)
  114.         'REQUESTLIST INSTEM 'userlist' OUTSTEM 'seluser' TITLE "Select user(s) or Cancel for next message" SIZEGADGET MULTISELECT'
  115.  
  116.         select
  117.             when (rc > 5) then do
  118.                 'REQUESTNOTIFY "REQUESTLIST failed: ' || THOR.LASTERROR || '" "Ok"'
  119.                 exit(0)
  120.             end
  121.  
  122.             when (rc = 5) then cancelled = 1
  123.  
  124.             otherwise do
  125.                 do u = 1 to seluser.COUNT
  126.                     selected = seluser.u
  127.  
  128.                     drop new. useredit.
  129.  
  130.                     do j = 1 to addrs.count while selected = seluser.u
  131.                         if selected = userlist.j then selected = j
  132.                     end
  133.  
  134.                     new.name      = addrs.selected.name
  135.                     new.address   = addrs.selected.addr
  136.                     new.comment.1 = ''
  137.                     new.alias     = ''
  138.                     finished      = 0
  139.  
  140.                     do while ~(finished)
  141.                         useredit.1 = 'Add this new user'
  142.                         useredit.2 = ''
  143.                         useredit.3 = 'Name:  ' || new.name
  144.                         useredit.4 = 'Addr:  ' || new.address
  145.                         useredit.5 = 'Alias: ' || new.alias
  146.                         useredit.6 = 'Comm:  ' || new.comment.1
  147.                         useredit.count = 6
  148.  
  149.                         address(thorport)
  150.                         'REQUESTLIST INSTEM 'useredit' TITLE "Edit user" SIZEGADGET'
  151.                         if (rc > 5) then do
  152.                             'REQUESTNOTIFY "REQUESTLIST failed: ' || THOR.LASTERROR || '" "Ok"'
  153.                             exit(0)
  154.                         end
  155.                         choice = result
  156.  
  157.                         choice = result
  158.                         do j = 1 to useredit.count while choice = result
  159.                             if choice = useredit.j then choice = j
  160.                         end
  161.  
  162.                         select
  163.                             when (rc > 5) then do
  164.                                 'REQUESTNOTIFY "REQUESTLIST failed: ' || THOR.LASTERROR || '" "Ok"'
  165.                                 exit(0)
  166.                             end
  167.  
  168.                             when (rc = 5) then finished = 1
  169.  
  170.                             when (rc = 0) & (choice = 3) then do
  171.                                 'REQUESTSTRING TITLE="Enter Name:" BT="Ok|Cancel" ID="'||addasterix(new.name)||'" MAXCHARS=100'
  172.                                 if rc = 0 then new.name = result
  173.                                 else if (rc > 5) then do
  174.                                     'REQUESTNOTIFY "REQUESTSTRING failed: ' || THOR.LASTERROR || '" "Ok"'
  175.                                     exit(0)
  176.                                 end
  177.                             end
  178.  
  179.                             when (rc = 0) & (choice = 4) then do
  180.                                 REQUESTSTRING 'TITLE="Enter Address:" BT="Ok|Cancel" ID="'||addasterix(new.address)||'" MAXCHARS=100'
  181.                                 if rc = 0 then new.address = result
  182.                                 else if (rc > 5) then do
  183.                                     'REQUESTNOTIFY "REQUESTSTRING failed: ' || THOR.LASTERROR || '" "Ok"'
  184.                                     exit(0)
  185.                                 end
  186.                             end
  187.  
  188.                             when (rc = 0) & (choice = 5) then do
  189.                                 'REQUESTSTRING TITLE="Enter Alias:" ID="' || addasterix(new.alias) || '" BT="Ok|Cancel" MAXCHARS=100'
  190.                                 if rc = 0 then new.alias = result
  191.                                 else if (rc > 5) then do
  192.                                     'REQUESTNOTIFY "REQUESTSTRING failed: ' || THOR.LASTERROR || '" "Ok"'
  193.                                     exit(0)
  194.                                 end
  195.                             end
  196.  
  197.                             when (rc = 0) & (choice = 6) then do
  198.                                 REQUESTSTRING 'TITLE="Enter Comment:" ID="' || addasterix(new.comment.1) || '" BT="Ok|Cancel" MAXCHARS=100'
  199.                                 if rc = 0 then new.comment.1 = result
  200.                                 else if (rc > 5) then do
  201.                                     'REQUESTNOTIFY "REQUESTSTRING failed: ' || THOR.LASTERROR || '" "Ok"'
  202.                                     exit(0)
  203.                                 end
  204.                             end
  205.  
  206.                             when (rc = 0) & (choice = 1) then do
  207.                                 if new.comment.1 = "" then new.comment.count = 0; else new.comment.count = 1
  208.                                 deluser = 0; drop userseach.
  209.  
  210.                                 address(bbsread)
  211.                                 'SEARCHBRUSER BBSNAME "'cursys.bbsname'" STEM 'usersearch' SEARCH "' || addasterix(new.address) || '" ADDRESS'
  212.                                 if (rc ~= 0) then do
  213.                                     address(thorport)
  214.                                     'REQUESTNOTIFY "SEARCHBRUSER failed: ' || BBSREAD.LASTERROR || '" "Ok"'
  215.                                     exit(0)
  216.                                 end
  217.                                 address(thorport)
  218.                                 if (result > 0) then do
  219.                                     'REQUESTNOTIFY "A user with this address already\nexists. Do you want to replace\nthis user?" "Yes|No"'
  220.                                     if (result > 0) then deluser = 1
  221.                                 end
  222.                                 firstsearch = usersearch.1.usernr
  223.  
  224.                                 address(bbsread)
  225.                                 'SEARCHBRUSER BBSNAME "'cursys.bbsname'" STEM 'usersearch' SEARCH "' || addasterix(new.name) || '" NAME'
  226.                                 if (rc ~= 0) then do
  227.                                     address(thorport)
  228.                                     'REQUESTNOTIFY "SEARCHBRUSER failed: ' || BBSREAD.LASTERROR || '" "Ok"'
  229.                                     exit(0)
  230.                                 end
  231.                                 if (result > 0) & ~(deluser) & ~(usersearch.1.usernr = firstsearch) then do
  232.                                     address(thorport)
  233.                                     'REQUESTNOTIFY "A user with this name already\nexists. Do you want to replace\nthis user?" "Yes|No"'
  234.                                     if (result > 0) then deluser = 1
  235.                                 end
  236.  
  237.                                 if (deluser) then do
  238.                                     address(bbsread)
  239.                                     'WRITEBRUSER "'cursys.bbsname'" UPDATEUSERNR 'usersearch.1.USERNR' DELETEUSER'
  240.                                     if (rc ~= 0) then do
  241.                                         address(thorport)
  242.                                         'REQUESTNOTIFY "WRITEBRBRUSER failed: ' || BBSREAD.LASTERROR || '" "Ok"'
  243.                                         exit(0)
  244.                                     end
  245.                                 end
  246.  
  247.                                 address(bbsread)
  248.                                 'WRITEBRUSER "' || cursys.bbsname || '" STEM 'new
  249.                                 if (rc ~= 0) then do
  250.                                     address(thorport)
  251.                                     'REQUESTNOTIFY "WRITEBRUSER failed: ' || BBSREAD.LASTERROR || '" "Ok"'
  252.                                     exit(0)
  253.                                 end
  254.                                 finished = 1
  255.                             end
  256.  
  257.                             otherwise nop
  258.                         end /* select */
  259.  
  260.                     end /* ~(finished) */
  261.                 end /* do i = 1 to seluser.COUNT */
  262.  
  263.             end /* otherwise */
  264.         end /* select */
  265.  
  266.     end /* ~(cancelled) */
  267. end
  268.  
  269. syntax:
  270. break_c:
  271. halt:
  272.  
  273. exit
  274.  
  275.  
  276.  /****************************************************************************
  277. *************** Put addresses and names in a string into a stem ***************
  278.  ****************************************************************************/
  279.  
  280. parseaddr: procedure expose addrs. text. head.
  281.            parse arg checkfromaddr, checkcc
  282.  
  283. i = 1; acnt = 0; usedhead = 0; drop addrs.
  284.  
  285. if checkfromaddr = 1 then do
  286.     acnt = acnt + 1; addrs.acnt.name = head.FROMNAME
  287.     if (symbol('head.FROMADDR') = 'VAR') then addrs.acnt.addr = head.FROMADDR
  288.     else addrs.acnt.addr = ''
  289. end
  290.  
  291. if (symbol('head.TOADDR') = 'VAR') & ~(index(head.TOADDR, ',') > 0) then do
  292.     acnt = acnt + 1; addrs.acnt.name = ''; addrs.acnt.cc = 0; usedhead = 1
  293.     addrs.acnt.addr = head.TOADDR
  294.     if (symbol('head.TONAME') = 'VAR') then addrs.acnt.name = head.TONAME
  295. end
  296.  
  297. if (symbol('text.COMMENT.COUNT') = 'VAR') then if (text.COMMENT.COUNT > 0) then do while i <= text.COMMENT.COUNT
  298.     thiscc = 0
  299.  
  300.     if (checkcc = 1) & (upper(subword(text.COMMENT.i, 1, 1)) = 'CC:') then thiscc = 1
  301.  
  302.     if (thiscc) | (upper(subword(text.COMMENT.i, 1, 1)) = 'TO:') then do
  303.         addrs = subword(text.COMMENT.i, 2)
  304.         do forever
  305.             addrs = strip(addrs, 'B', ' ' || '09'x)
  306.  
  307.             offset = 1
  308.             do forever
  309.                 length = index(substr(addrs, offset), ','); if (length = 0) then length = length(addrs) - offset + 1
  310.                 thisaddr = strip(substr(addrs, offset, length), 'B', ', ');
  311.                 acnt = acnt + 1; addrs.acnt.addr = ''; addrs.acnt.name = ''
  312.                 if (thiscc) then addrs.acnt.cc = 1; else addrs.acnt.cc = 0
  313.  
  314.                 if (words(thisaddr) = 1) then addrs.acnt.addr = strip(thisaddr, 'B', '<>()')
  315.                 else if (index(thisaddr, '<') > 0) then do
  316.                     addrstart  = index(thisaddr, '<')
  317.                     addrlength = index(substr(thisaddr, addrstart), '>')
  318.                     addrs.acnt.addr = strip(substr(thisaddr, addrstart + 1, addrlength), 'B', '> ')
  319.                     addrs.acnt.name = strip(delstr(thisaddr, addrstart, addrlength), 'B', ' "' || '27'x)
  320.                 end
  321.                 else do j = 1 to words(thisaddr)
  322.                     thispart = strip(subword(thisaddr, j, 1), 'B', '<>" ' || '27'x)
  323.                     if (index(thispart, '@') > 0) then addrs.acnt.addr = thispart
  324.                     else addrs.acnt.name = addrs.acnt.name || thispart || ' '
  325.                 end
  326.  
  327.                 if ~(thiscc) & (usedhead) & (addrs.acnt.addr = addrs.1.addr) & (addrs.acnt.name = addrs.1.name) then do
  328.                     drop addrs.acnt.; acnt = acnt - 1
  329.                 end
  330.  
  331.                 if (offset + length >= length(addrs)) then break
  332.                 offset = offset + length
  333.             end
  334.  
  335.             j = i + 1; if ~((c2d(left(text.COMMENT.j, 1)) = 9) | (c2d(left(text.COMMENT.j, 1)) = 32)) then break
  336.             i = i + 1; addrs = text.COMMENT.i
  337.         end
  338.     end
  339.     i = i + 1
  340. end
  341.  
  342. addrs.COUNT = acnt
  343.  
  344. return(0)
  345.  
  346.  
  347.  /****************************************************************************
  348. ****** Insert asterix (*) before double quotes (") and existing asterixes *****
  349.  ****************************************************************************/
  350.  
  351. addasterix: procedure
  352.             parse arg str
  353.  
  354. if str = '' then return(str)
  355.  
  356. lastfound = 0; found = index(str, '*')
  357. do while found > lastfound
  358.     secondpart = substr(str, found + length('*'))
  359.     firstpart = substr(str, 1, length(str) - length(substr(str, found)))
  360.     str = firstpart || '**' || secondpart
  361.     lastfound = found + length('**')
  362.     found = index(str, '*', lastfound)
  363. end
  364.  
  365. lastfound = 0; found = index(str, '"')
  366. do while found > lastfound
  367.     secondpart = substr(str, found + length('"'))
  368.     firstpart = substr(str, 1, length(str) - length(substr(str, found)))
  369.     str = firstpart || '*"' || secondpart
  370.     lastfound = found + length('*"')
  371.     found = index(str, '"', lastfound)
  372. end
  373.  
  374. return(str)
  375.